COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00010 00003	(defmacro foo (x)
C00011 ENDMK
C⊗;

(DEFUN ANALYZE-CMPD-CONCEPT (LT-FORM &optional AL-VARS)
       (CASEQ (LT-CONCEPT-TYPE LT-FORM)
	      ((ATOMICPROPO F-TERM)
	       (SETF (ROLELINKS (CONCEPT-BODY LT-FORM))
		     (ORDER-ROLELINKS (CONCEPT-BODY LT-FORM)) )
	       (COND (
		      (FUNCALL (ISA-OF:LT . λ-EXPR) LT-FORM)
		      (LET ((DO-LIST))
			   (COND ((SETQ DO-LIST (MERGED-PKLS (LT-PATHKEYLISTS LT-FORM)))
				  (ANALYZE-ROLEMERGE DO-LIST LT-FORM) )
				 ((SETQ DO-LIST (INST-KEYS LT-FORM))
				  (ANALYZE-INSTANTIATION DO-LIST LT-FORM) )
				 ((ANALYZE-ADVERBIALIZATION LT-FORM)) ) ) )
		     ((ANALYZE-INSTANTIATION (INST-KEYS LT-FORM) LT-FORM)) ) )
	      (QUANTIFIERFORM

	       (LET* ((QUANTBODY (CONCEPT-BODY LT-FORM))
		      (OLDPATHKEYLISTS (COND (
					      (FUNCALL (ISA-OF:LT . λ-EXPR) LT-FORM)
					      (LT-PATHKEYLISTS LT-FORM))) )

		      (QSORT-NEWPATHKEYLIST
		       (CONS 
(TERMSORT QUANTBODY)
			     (ORDER-PATHKEYS
			      (MAPCAR #'IMPLODE
				      (QUANT-QUASI-UNSUBST
				       QUANTBODY
				       
				       (FUNCALL (THE-OF:LT-QUANT . QSORTEXPR) QUANTBODY)
				       ) ) ) ) )

		      (SCOPE-NEWPATHKEYLIST
		       (CONS (TERMSORT QUANTBODY)
			     (ORDER-PATHKEYS
			      (MAPCAR #'IMPLODE
				      (QUANT-QUASI-UNSUBST
				       QUANTBODY
				       (FUNCALL (THE-OF:LT-QUANT . SCOPE) QUANTBODY)
				       ) ) ) ) )
		      (QSORTλ-EXPR (SETUP-λ-EXPR QSORT-NEWPATHKEYLIST
						 OLDPATHKEYLISTS  'A
						 
						 (FUNCALL (THE-OF:LT-QUANT . QSORTEXPR) QUANTBODY)
						 ))
		      (SCOPEλ-EXPR (SETUP-λ-EXPR SCOPE-NEWPATHKEYLIST
						 OLDPATHKEYLISTS  'B
						 
						 (FUNCALL (THE-OF:LT-QUANT . SCOPE) QUANTBODY)
						 ))
		      (Q-OPERATOR (GET-Q-OP QSORT-NEWPATHKEYLIST QSORTλ-EXPR
					    SCOPE-NEWPATHKEYLIST SCOPEλ-EXPR )) )
		     (LIST Q-OPERATOR
			   (FUNCALL (THE-OF:LT-QUANT . DETERMINER) QUANTBODY)
			   (NRML-ANL-YZE-CC QSORTλ-EXPR AL-VARS)
			   (NRML-ANL-YZE-CC SCOPEλ-EXPR AL-VARS) ) )

 )
	      (↑-TERM
	       (LET* ((λ-EXPR-FLAG 
		       (FUNCALL (ISA-OF:LT . λ-EXPR) LT-FORM)
		       )
		      (↑-MATRIX-EXPR
		       (COND
			(λ-EXPR-FLAG
			 (LET ((λ-SCOPE (↑↓-MATRIX (LT-λ-SCOPE LT-FORM))))
			      (COND ((AND (EQ 'ATOMICPROPO (LT-TYPE λ-SCOPE))
					  (ATOM-CONVERTIBLE (LT-PATHKEYLISTS LT-FORM)
							    λ-SCOPE ) )
				     (PFC-CONCEPT λ-SCOPE) )
				    (T (MAKE-LT-λ-EXPR
					λ-PREFIX (MAKE-LT-λ-PREFIX
						  PATHKEYLISTS 
						  (COPYALLCONS
						   (LT-PATHKEYLISTS LT-FORM) ) )
					λ-SCOPE λ-SCOPE )) ) ) )
			(T (↑↓-MATRIX LT-FORM)) ) ) )
		     (COND (λ-EXPR-FLAG (LOWER-λ-TERMSORTS
					 (LT-PATHKEYLISTS ↑-MATRIX-EXPR) )))
		     (COND ((MEMQ '↑-MATRIX-ANALYSIS-LIST AL-VARS)
			    (PROCESS-↑-MATRIX ↑-MATRIX-EXPR λ-EXPR-FLAG) )
			   (T (1ST-PROCESS-↑-MATRIX ↑-MATRIX-EXPR λ-EXPR-FLAG)) ) ) )
	      (NEGPROPO
	       (LET* ((JUNCT-MATRIX (ARGUMENT (CAR (ROLELINKS (CONCEPT-BODY LT-FORM)))))
		      (JUNCT-EXPR
		       (COND (
			      (FUNCALL (ISA-OF:LT . λ-EXPR) LT-FORM)
			      (LET ((NEWPATHKEYLISTS
				     (SELECT&SHORTEN 'A (LT-PATHKEYLISTS LT-FORM))))
				   (COND ((AND (EQ 'ATOMICPROPO (LT-TYPE JUNCT-MATRIX))
					       (ATOM-CONVERTIBLE NEWPATHKEYLISTS
								 JUNCT-MATRIX ) )
					  (PFC-CONCEPT JUNCT-MATRIX) )
					 (T (MAKE-LT-λ-EXPR
					     λ-PREFIX (MAKE-LT-λ-PREFIX
						       PATHKEYLISTS NEWPATHKEYLISTS )
					     λ-SCOPE JUNCT-MATRIX )) ) ) )
			     (T JUNCT-MATRIX) ) ) )
		     (LIST 'CNCT*A '¬ (NRML-ANL-YZE-CC JUNCT-EXPR AL-VARS)) ) )
	      ((CONJ-PROPO DISJ-PROPO)
	       (PUSH 'JUNCT-ANALYSIS-LIST AL-VARS)
	       (DO ((ARGTAIL (ROLELINKS (CONCEPT-BODY LT-FORM)) (CDR ARGTAIL))
		    (ALPHATAIL ALPHABET (CDR ALPHATAIL))
		    (JUNCT-MATRIX) (JUNCT-EXPR) (JUNCT-PATHKEYLISTS)
		    (NORML-JUNCT-LIST) (JUNCT-ANALYSIS-LIST) )
		   ((NULL ARGTAIL)
		    (FIX-AL JUNCT-ANALYSIS-LIST)
		    (SETQ NORML-JUNCT-LIST (ORDER-JUNCTS (CULL-EQS NORML-JUNCT-LIST)
							 JUNCT-ANALYSIS-LIST ) )
		    (LIST* (IMPLODE (NCONC (EXPLODE 'CNCT*)
					   (NCONS (PREVIOUS-LETTER (CAR ALPHATAIL))) ))
			   (PFC-CONCEPT (CONCEPT-BODY LT-FORM))
			   NORML-JUNCT-LIST ) )
		   (SETQ JUNCT-MATRIX (ARGUMENT (CAR ARGTAIL))
			 JUNCT-EXPR
			 (COND (
				(FUNCALL (ISA-OF:LT . λ-EXPR) LT-FORM)
				(SETQ JUNCT-PATHKEYLISTS
				      (SELECT&SHORTEN (CAR ALPHATAIL)
						      (LT-PATHKEYLISTS LT-FORM) ) )
				(COND ((AND (EQ 'ATOMICPROPO (LT-TYPE JUNCT-MATRIX))
					    (ATOM-CONVERTIBLE JUNCT-PATHKEYLISTS
							      JUNCT-MATRIX ) )
				       (PFC-CONCEPT JUNCT-MATRIX) )
				      (T (MAKE-LT-λ-EXPR
					  λ-PREFIX (MAKE-LT-λ-PREFIX
						    PATHKEYLISTS JUNCT-PATHKEYLISTS )
					  λ-SCOPE JUNCT-MATRIX )) ) )
			       (T JUNCT-MATRIX) ) )
		   (ENDADD (NRML-ANL-YZE-CC JUNCT-EXPR AL-VARS) NORML-JUNCT-LIST) ) )
	      (T (BREAK "ANALYZE-CMPD-CONCEPT - unrecognized form type")) ) )
(defmacro foo (x)
 `(let* ((foo 7))
       (foo ,x)))

(foo 2)